home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / mpfeel.lha / MPFeel / Plurals / Modules / tori.em < prev   
Lisp/Scheme  |  1992-06-04  |  1KB  |  40 lines
  1. (defmodule tori (standard0 ppl  plural) ()
  2.     
  3. (defconstant N 0)
  4. (defconstant E 1)
  5. (defconstant S 2)
  6. (defconstant W 3)
  7. (defconstant NE 4)
  8. (defconstant NW 5)
  9. (defconstant SE 6)
  10. (defconstant SW 7)
  11.  
  12.   (defun inverse (map)
  13.     (match (index map) (move (index map) map cons ())))
  14.  
  15. (defun make-bi-torus (w h)
  16.   (let ((new (make-paralation (* w h)))
  17.     (shape-vec (make-vector 8)))
  18.     ((setter vector-ref) shape-vec N
  19.      (match new (elwise (new) (remainder (+ new w) (* w h)))))
  20.     ((setter vector-ref) shape-vec S (inverse (vector-ref shape-vec N)))
  21.     ((setter vector-ref) shape-vec E
  22.      (match new (elwise (new) (let ((tmp (remainder new w)))
  23.                 (if (eq tmp 0) (+ new (- w 1)) (- new 1))))))
  24.     ((setter vector-ref) shape-vec W (inverse (vector-ref shape-vec E)))
  25.     ((setter vector-ref) shape-vec NE 
  26.      (match (move (move new (vector-ref shape-vec N) cons ()) 
  27.           (vector-ref shape-vec E) cons ()) new))
  28.     ((setter vector-ref) shape-vec SW (inverse (vector-ref shape-vec NE)))
  29.     ((setter vector-ref) shape-vec NW
  30.      (match (move (move new (vector-ref shape-vec N) cons ()) 
  31.           (vector-ref shape-vec W) cons ()) new))
  32.     ((setter vector-ref) shape-vec SE (inverse (vector-ref shape-vec NW)))    
  33.     ((setter shape) new shape-vec)
  34.     new))
  35.  
  36. (export N S E W NE NW SE SW make-bi-torus)
  37. )
  38.     
  39.     
  40.